home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue26 / lightchk / LIGHTCHK.ZIP / lightchk.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-12-28  |  4.1 KB  |  194 lines
  1. unit Lightchk;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls;
  8.  
  9. type
  10.   TLightCheck = class(TCustomControl)
  11.   private
  12.     PFState: TCheckBoxState;
  13.     FOnColor,
  14.     FOffColor  : TColor;
  15.     function GetChecked: Boolean;
  16.     procedure SetChecked(Value: Boolean);
  17.     procedure SetOnColor(Value: TColor);
  18.     procedure SetOffColor(Value: TColor);
  19.   protected
  20.     procedure Paint; override;
  21.     procedure Toggle; virtual;
  22.     procedure Click; override;
  23.   public
  24.     constructor Create(aOwner: TComponent); override;
  25.     procedure CreateParams(var Params: TCreateParams); override;
  26.     property State: TCheckBoxState read PFState;
  27.   published
  28.     property Checked: Boolean read GetChecked write SetChecked;
  29.     property OnColor: TColor read FOnColor write SetOnColor default clLime;
  30.     property OffColor: TColor read FOffColor write SetOffColor default clRed;
  31.     property OnClick;
  32.     property OnDragDrop;
  33.     property OnDragOver;
  34.     property OnEndDrag;
  35.     property OnMouseDown;
  36.     property OnMouseMove;
  37.     property OnMouseUp;
  38.     property OnEnter;
  39.     property OnExit;
  40.     property OnKeyPress;
  41.     property OnKeyDown;
  42.     property OnKeyUp;
  43.   end;
  44.  
  45.  
  46.  
  47. procedure Register;
  48.  
  49.  
  50.  
  51. implementation
  52.  
  53. uses
  54.     ExtCtrls;
  55.  
  56.  
  57. constructor TLightCheck.Create;
  58. begin
  59.   inherited Create(aOwner);
  60.   ControlStyle := [csCaptureMouse, csClickEvents, csDesignInteractive];
  61.   FOnColor := clLime;
  62.   FOffColor := clRed;
  63.   Width := 7;
  64.   Height := 7;
  65. end;
  66.  
  67.  
  68. procedure TLightCheck.CreateParams(var Params: TCreateParams);
  69. begin
  70.   { call the create of the params }
  71.   inherited CreateParams(Params);
  72.   { and then add our twist, transparency }
  73.   Params.ExStyle := Params.ExStyle + WS_EX_Transparent;
  74. end;
  75.  
  76.  
  77.  
  78. procedure TLightCheck.Paint;
  79. var
  80.    X,
  81.    Y        : Integer;
  82.    TheColor : TColor;
  83. begin
  84.   X := (Width div 2) - 3;
  85.   Y := (Height div 2) - 3;
  86.  
  87.   if Checked then
  88.     TheColor := FOnColor
  89.   else
  90.     TheColor := FOffColor;
  91.  
  92.   with Canvas do
  93.   begin
  94. {  7x7 }
  95.     Pixels[X+2, Y] := clBtnShadow;
  96.     Pixels[X+3, Y] := clBtnShadow;
  97.     Pixels[X+4, Y] := clBtnShadow;
  98.     Pixels[X+1, Y+1] := clBtnShadow;
  99.     Pixels[X, Y+2] := clBtnShadow;
  100.     Pixels[X, Y+3] := clBtnShadow;
  101.     Pixels[X, Y+4] := clBtnShadow;
  102.     Pixels[X+1, Y+5] := clBtnShadow;
  103.  
  104.     Pixels[X+6, Y+2] := clBtnHighLight;
  105.     Pixels[X+6, Y+3] := clBtnHighLight;
  106.     Pixels[X+6, Y+4] := clBtnHighLight;
  107.     Pixels[X+5, Y+1] := clBtnHighLight;
  108.     Pixels[X+2, Y+6] := clBtnHighLight;
  109.     Pixels[X+3, Y+6] := clBtnHighLight;
  110.     Pixels[X+4, Y+6] := clBtnHighLight;
  111.     Pixels[X+5, Y+5] := clBtnHighLight;
  112.     Pixels[X+2, Y+3] := clBtnHighLight;
  113.  
  114.     Pixels[X+2, Y+1] := TheColor;
  115.     Pixels[X+3, Y+1] := TheColor;
  116.     Pixels[X+4, Y+1] := TheColor;
  117.     Pixels[X+1, Y+2] := TheColor;
  118.     Pixels[X+2, Y+2] := TheColor;
  119.     Pixels[X+3, Y+2] := TheColor;
  120.     Pixels[X+4, Y+2] := TheColor;
  121.     Pixels[X+5, Y+2] := TheColor;
  122.     Pixels[X+1, Y+3] := TheColor;
  123.     Pixels[X+3, Y+3] := TheColor;
  124.     Pixels[X+4, Y+3] := TheColor;
  125.     Pixels[X+5, Y+3] := TheColor;
  126.     Pixels[X+1, Y+4] := TheColor;
  127.     Pixels[X+2, Y+4] := TheColor;
  128.     Pixels[X+3, Y+4] := TheColor;
  129.     Pixels[X+4, Y+4] := TheColor;
  130.     Pixels[X+5, Y+4] := TheColor;
  131.     Pixels[X+2, Y+5] := TheColor;
  132.     Pixels[X+3, Y+5] := TheColor;
  133.     Pixels[X+4, Y+5] := TheColor;
  134. {  7x7 }
  135.   end;
  136. end;
  137.  
  138.  
  139. function TLightCheck.GetChecked;
  140. begin
  141.   Result := not(State = cbUnChecked);
  142. end;
  143.  
  144.  
  145. procedure TLightCheck.SetChecked;
  146. begin
  147.   if Value then
  148.     PFState := cbChecked
  149.   else
  150.     PFState := cbUnChecked;
  151.  
  152.   Paint;
  153. end;
  154.  
  155.  
  156. procedure TLightCheck.Toggle;
  157. begin
  158.   Checked := not Checked;
  159. end;
  160.  
  161.  
  162. procedure TLightCheck.Click;
  163. begin
  164.   Toggle;
  165. end;
  166.  
  167.  
  168. procedure TLightCheck.SetOnColor;
  169. begin
  170.   FOnColor := Value;
  171.   if Checked then
  172.     Paint;
  173. end;
  174.  
  175.  
  176. procedure TLightCheck.SetOffColor;
  177. begin
  178.   FOffColor := Value;
  179.   if not Checked then
  180.     Paint;
  181. end;
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188. procedure Register;
  189. begin
  190.   RegisterComponents('Standard', [TLightCheck]);
  191. end;
  192.  
  193. end.
  194.